home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / yerk / mps231ss.hqx / Mops source / Module source / PopupMenuMod.txt < prev    next >
Text File  |  1993-02-06  |  3KB  |  109 lines

  1. \ Class PopupMenu.  This version handles pop-up menus in dialogs.  If we
  2. \ ever need one somewhere else, we'll have to define a subclass with
  3. \ different HIT: and NORMAL: methods.
  4.  
  5.  
  6. objPtr    THEDLG        class_is dialog+
  7.  
  8.  
  9. :class POPUPMENU    super{ menu }
  10.  
  11.     string+    ITEMTEXT    \ Current text displayed in pop-up box
  12.     int        ITEM#        \ Current item # displayed in pop-up box
  13.     int        BOX#        \ Dialog item# of pop-up box
  14.     int        TITLE#        \ Dialog item# of pop-up title
  15.     rect    TITLERECT
  16.     rect    POPUPBOX
  17.     dicAddr    ^DLG        \ Points to owning dialog
  18.     ptr        F-LINK        \ Forward link for chain of pop-up menus
  19.                         \  belonging to the one dialog
  20.  
  21. :m GETTEXT:        ( -- addr len )    get: itemText  ;m
  22. :m ITEM#:        ( -- item# )    get: item#   ;m
  23. :m PUTITEM#:    ( item# -- )    put: item#   ;m
  24. :m PUTTITLE#:    ( title# -- )    put: title#  ;m
  25. :m PUT^DLG:        ( ^dlg -- )    put: ^dlg  ;m
  26. :m F-LINK:        get: F-link  ;m
  27. :m SET-F-LINK:    put: F-link  ;m
  28. :m BOX#:        get: box#  ;m
  29.  
  30. private
  31.  
  32. :m CHKDLG:    \ ( -- b )
  33.     get: ^dlg  this_dlg  =  ;m
  34.  
  35. :m DT:
  36.     chkDlg: self  0EXIT
  37.     get: itemtext  addr: popUpBox  1 makeint call textBox  ;m
  38.  
  39. public
  40.  
  41. :m INIT:    \ ( cfa-list resid box# title# -- )
  42.     put: title#  put: box#  init: super  ;m
  43.  
  44. :m GETNEW:
  45.     new: itemText  getNew: super
  46.     get: Mhndl  -1 makeint  call InsertMenu  ;m
  47.  
  48. :m NORMAL:
  49.     savePort  dlgPort
  50.     invert: titleRect
  51.     restPort  ;m
  52.  
  53.  
  54. :m DRAWTEXT:
  55.     chkDlg: self  0EXIT
  56.     savePort  dlgPort  dt: self
  57.     restPort  ;m
  58.  
  59. :m PUTTEXT:        \ ( addr len -- )  Doesn't draw the text, since THIS_DLG
  60.                 \ may not be valid.
  61.     put: itemText  ;m
  62.  
  63.  
  64. :m DRAWBOX:    \ Called from DRAWBOX, which is called from PUboxProc.
  65.     chkDlg: self  0EXIT
  66.     get: box#  itemHandle: this_dlg  drop
  67.     tempRect ->: popUpBox
  68.     dropShadow: popUpBox
  69.     getBotX: popUpBox  19 -
  70.     getTopY: popUpBox   6 +  moveto  del
  71.     1 1 inset: popUpBox  getBotX: popUpBox  20 -  putBotX: popUpBox
  72.                     \ So box outline and down arrow aren't wiped
  73.     dt: self  ;m
  74.  
  75.  
  76. :m HIT:
  77.     get: title#  itemHandle: this_dlg drop
  78.     tempRect ->: titleRect
  79.     savePort  dlgPort
  80.     invert: titleRect
  81.     get: theItem  itemHandle: this_dlg  drop    \ Set TempRect to pop-up box
  82.     0
  83.     get: Mhndl
  84.     topint: tempRect  l->g  unpack swap pack
  85.     get: item# 1+  makeint
  86.     call PopUpMenuSelect
  87.     unpack  drop  1-                    \ our item# - one less than Toolbox's
  88.     dup 0>=
  89.     IF    dup getitem: super  putText: self  dt: self
  90.         restPort
  91.         dup exec: super                    \ Execute action handler
  92.                 \ Note: the old item# is still in the item# field, but the
  93.                 \ new one is on the stack.  This should be useful when we
  94.                 \ need to know if the item# is being changed.
  95.         put: item#
  96.     ELSE
  97.         drop  restPort
  98.     THEN
  99.     normal: self  ;m
  100.  
  101. :m LINK:    \ ( ^dlg -- )
  102.     -> theDlg
  103.     theDlg  put^dlg: self
  104.     ['] PUboxProc  get: box#  setUserProc: theDlg
  105.     PUM-link: theDlg  put: F-link
  106.     ^base  set-PUM-link: theDlg  ;m
  107.  
  108. ;class
  109.